Shareware Overload Trio 2/Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO/dir39/borfix.zip/EMS.PAS

Pascal/Delphi Source File | 1989-08-28 | 5KB | 220 lines

  unit ems;
  {*****************************************************}
  {*                                                   *}
  {*                 Expanded Memory Unit              *}
  {*                                                   *}
  {*                    By:MB Software                 *}
  {*                       89/08/29                    *}
  {*                        V. 1.0                     *}
  {*****************************************************}
  {*The unit supports the EMM 3.2+.All functions marked*}
  {*with a plus sign should not be used with the       *}
  {*functions with a minus sign.Of course this will not*}
  {*the system or anything but the functions with a    *}
  {*plus sign use the functions with the negative signs*}
  {*.                                                  *}
  {*Reference:Advanced DOS,BYTE volume 10,#11          *}
  {*By: Michael Hyman,Ray Duncan                       *}
  {*Published by: MIS:PRESS,McGraw-Hill                *}
  {*****************************************************}
  interface
  type
  st5=string[5];
  st=string[3];
  var
  base,handle,pages:word;
  function hex_string(number: word): ST5;
  function emm_driver:word;
  function get_frame(var frame:word): word;
  function unalloc_p(var tp,up:word): word;
  function alloc_page(var handle:word;var page:word): word;{-}
  function map_page(var phys_page,log_page,handle:word): word;{-}
  function dealloc_page(var handle:word): word;{-}
  function version(var v,f:word): word;
  function alloc_all:word;{+}
  function writ_byte(var page,byte,value:word):word;{+}
  function rd_byte(var page,byte:word):word;{+}
  function dealloc_all:word;{+}
  function Get_EMM_handles:word;
  function get_pages_owned_by_handle(var han:word):word;
  implementation
  uses dos;
  Function Hex_String(Number: Word): ST5;
  Function Hex_Char(Number: Word): Char;
  begin
  If Number<10 then Hex_Char:=Char(Number+48) else Hex_Char:=Char(Number+55);
  end;

  var
  S: ST5;
  begin
  S:='';
  S:=Hex_Char( (Number shr 1) div 2048);
  Number:=( ((Number shr 1) mod 2048) shl 1)+
        (Number and 1) ;
  S:=S+Hex_Char(Number div 256);
  Number:=Number mod 256;
  S:=S+Hex_Char(Number div 16);
  Number:=Number mod 16;
  S:=S+Hex_Char(Number);
    Hex_String:=S+'h';
  end; { Function Hex_String }
function emm_driver:word;
var
regs:registers;
pos:word;
driver:string[8];
found:string[8];
begin
found:='';
driver:='EMMXXXX0';
with regs do
begin
ah:=$35;
al:=$67;
intr($21,regs);
for pos:=0 to 7 do found:=found+chr(mem[es:pos+$0A]);
emm_driver:=1;
if found<>driver then emm_driver:=0;
end;
end;
function get_frame(var frame:word): word;
var
regs:registers;
begin
with regs do
begin
ah:=$41;
intr($67,regs);
get_frame:=ah;
frame:= bx;
end;
end;
function alloc_page(var handle:word;var page:word):word;
var
regs:registers;
begin
with regs do
begin
ah:=$43;
bx:=page;
intr($67,regs);
handle:=dx;
alloc_page:=ah;
end;
end;
function unalloc_p(var tp,up:word):word;
var
regs:registers;
begin
with regs do
begin
ah:=$42;
intr($67,regs);
up:=bx;
tp:=dx;
unalloc_p:=ah;
end;
end;
function map_page(var phys_page,log_page,handle:word):word;
var
regs:registers;
begin
with regs do
begin
ah:=$44;
al:=phys_page;
bx:=log_page;
dx:=handle;
intr($67,regs);
map_page:=ah;
end;
end;
function dealloc_page(var handle:word): word;
var
regs:registers;
begin
with regs do
begin
ah:=$45;
dx:=handle;
intr($67,regs);
dealloc_page:=ah;
end;
end;
function version(var v,f:word): word;
var
regs:registers;
begin
with regs do
begin
ah:=$46;
intr($67,regs);
if ah=0 then begin
v:=al shr 4 ;
f:=al and $f;
end;
version:=ah;
end;
end;
function alloc_all:word;
var
a,b,c,d,error,frame:word;
begin
error:=get_frame(frame);
if error<>0 then alloc_all:=1;
error:=unalloc_p(a,b);
if error<>0 then alloc_all:=2;
error:=alloc_page(handle,b);
if error<>0 then alloc_all:=3;
pages:=b;
base:=frame;
end;
function rd_byte(var page,byte:word):word;
var
a,b,c,d,error:word;
begin
error:=get_frame(base);
c:=1;
error:=map_page(c,page,handle);
rd_byte:=mem[base:byte];
end;
function writ_byte(var page,byte,value:word):word;
var
a,b,c,d,error:word;
begin
writ_byte:=0;
if page>pages then writ_byte:=3;
c:=0;
error:=map_page(c,page,handle);
if error<>0 then writ_byte:=2;
mem[base:byte]:=value;
end;
function dealloc_all:word;
begin
dealloc_all:=dealloc_page(handle);
end;

function get_emm_handles:word;
var
regs:registers;
begin
with regs do begin
ah:=$4b;
intr($67,regs);
end;
end;
function get_pages_owned_by_handle(var han:word):word;
var
regs:registers;
begin
with regs do begin
ah:=$4c;
dx:=han;
intr($67,regs);
get_pages_owned_by_handle:=bx;
end;
end;
end.